home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #27 (Dec 87) / Tear off Menus example / tml version / TearMenu.Pas < prev    next >
Pascal/Delphi Source File  |  1987-08-31  |  21KB  |  757 lines
  1. {###############################################################################}
  2. {#                                           #}
  3. {#    Tear Menu - By Darryl Lovato of TML Systems, Inc.               #}
  4. {#                                           #}
  5. {###############################################################################}
  6.  
  7. program TearMenu;
  8.  
  9. uses MacIntf;
  10.  
  11. {###############################################################################}
  12. {#                                           #}
  13. {#                linker Directives Follow                   #}
  14. {#                                           #}
  15. {###############################################################################}
  16.  
  17. {$T APPL TEAR}
  18. {$B+}
  19. {$L TearMenuRes}
  20.  
  21. {###############################################################################}
  22. {#                                           #}
  23. {#                Global Contants Follow                   #}
  24. {#                                           #}
  25. {###############################################################################}
  26.  
  27. const
  28.   AppleMenuID = 1;
  29.   FileMenuID = 2;
  30.   EditMenuID = 3;
  31.   graphicalMenu = 4;
  32.   WindResID = 1;
  33.   AboutID = 3000;
  34.  
  35. {###############################################################################}
  36. {#                                           #}
  37. {#               Global Variables Follow                   #}
  38. {#                                           #}
  39. {###############################################################################}
  40.  
  41. var
  42.   myMenus : Array[AppleMenuID..EditMenuID] of MenuHandle;
  43.   Done : Boolean;
  44.   RegWDEFWindow : WindowPtr;
  45.   GrowArea : rect;
  46.   DragArea : rect;
  47.   myWindowPeek : WindowPeek;
  48.   MyGraphicsMenu : menuhandle;
  49.   currentPatWind : WindowPtr;
  50.  
  51. {###############################################################################}
  52. {#                                           #}
  53. {#                MyWindowDef function                   #}
  54. {#                                           #}
  55. {###############################################################################}
  56.  
  57. function MyWindowDef(varCode : Integer;
  58.             theWindow : WindowPtr;
  59.             message : Integer;
  60.             param : LongInt)
  61.             : LongInt;
  62. type
  63.   RectPtr = ^Rect;
  64.  
  65. var
  66.   aRectPtr : RectPtr;
  67.   myWindowPeek : WindowPeek;
  68.  
  69. procedure DoDrawMessage(WindToDraw : WindowPtr;
  70.               DrawParam : LongInt);
  71. var
  72.   TitleBarRect : Rect;
  73.   CurrentY : Integer;
  74.   index : Integer;
  75.   GoAwayBox : Rect;
  76.  
  77. begin
  78.   if WindowPeek(WindToDraw)^.visible then
  79.     begin
  80.  
  81.       TitleBarRect := WindowPeek(WindToDraw)^.strucRgn^^.rgnBBox;
  82.  
  83.       if DrawParam <> 0 then {just toggle goAway box}
  84.         begin
  85.       with TitleBarRect do
  86.         begin
  87.           top := top + 3;
  88.           left := left + 5;
  89.           bottom := top + 8;
  90.           right := left + 8;
  91.         end;
  92.       InsetRect(TitleBarRect,1,1);
  93.       InvertRect(TitleBarRect);
  94.     end 
  95.       else {we need to draw the window frame}
  96.         begin
  97.       PenNormal;
  98.  
  99.       FrameRect(TitleBarRect);
  100.  
  101.       TitleBarRect.bottom := TitleBarRect.top + 13;
  102.  
  103.       FrameRect(TitleBarRect);
  104.       InsetRect(TitleBarRect,1,1); {shrink by 1}
  105.       EraseRect(TitleBarRect);
  106.  
  107.       if WindowPeek(WindToDraw)^.hilited then 
  108.         begin { add hiliting }
  109.           FillRect(TitleBarRect,black);
  110.           with TitleBarRect do
  111.             begin
  112.               top := top + 2;
  113.               left := left + 4;
  114.               bottom := top + 8;
  115.               right := left + 8;
  116.             end;
  117.           PenMode(patXor);
  118.           FrameRect(TitleBarRect);
  119.           PenNormal;
  120.         end;
  121.     end;
  122.     end;
  123. end;
  124.  
  125. function DoHitMessage(WindToTest : WindowPtr;
  126.             theParam : LongInt) : LongInt;
  127. var
  128.   globalPt : Point;
  129.   aRect : Rect;
  130.   GoAwayBox : Rect;
  131.   tempRect : Rect;
  132. begin
  133.   globalPt.h := LoWord(theParam);
  134.   globalPt.v := HiWord(theParam);
  135.   aRect := WindowPeek(WindToTest)^.strucRgn^^.rgnBBox;
  136.   aRect.bottom := aRect.top + 12; {create tBar Rect}
  137.   tempRect := WindowPeek(WindToTest)^.strucRgn^^.rgnBBox;
  138.   if PtInRect(globalPt,tempRect) then {in structure rgn?}
  139.     begin
  140.       tempRect := WindowPeek(WindToTest)^.contRgn^^.rgnBBox;
  141.       if PtInRect(globalPt,tempRect) then {if it was in content rgn}
  142.         DoHitMessage := wInContent
  143.       else if PtInRect(globalPt,aRect) then {in the drag or go-away}
  144.         begin
  145.       if WindowPeek(WindToTest)^.hilited then 
  146.         begin {we need to check the go-away box}
  147.           with aRect do
  148.             begin
  149.               top := top + 2;
  150.               left := left + 4;
  151.               bottom := top + 8;
  152.               right := left + 8;
  153.             end;
  154.           if PtInRect(globalPt,aRect) then
  155.             DoHitMessage := wInGoAway
  156.           else
  157.             DoHitMessage := wInDrag;
  158.         end
  159.       else
  160.         DoHitMessage := wInDrag;
  161.     end
  162.       else {it was in our window frame}
  163.         DoHitMessage := wNoHit;
  164.     end
  165.   else {it wasn't in our window at all}
  166.     DoHitMessage := wNoHit;
  167. end;
  168.  
  169. procedure DoCalcRgnsMessage(WindToCalc : WindowPtr);
  170. var
  171.   tempRect : Rect;
  172.   aWindowPeek : WindowPeek;
  173.   aRgn : RgnHandle;
  174. begin
  175.   tempRect := WindToCalc^.PortRect;
  176.   
  177.   OffsetRect(tempRect, -WindToCalc^.PortBits.Bounds.Left,
  178.                 -WindToCalc^.PortBits.Bounds.Top);
  179.  
  180.   dec(TempRect.top);
  181.   RectRgn(WindowPeek(WindToCalc)^.contRgn,tempRect); 
  182.   
  183.   InsetRect(tempRect,-1,-1);
  184.   tempRect.top := tempRect.top - 12;
  185.   RectRgn(WindowPeek(WindToCalc)^.strucRgn,tempRect);
  186. end;
  187.  
  188. begin
  189.   MyWindowDef := 0;
  190.   case message of
  191.     wDraw : DoDrawMessage(theWindow, param);
  192.     wHit : MyWindowDef := DoHitMessage(theWindow,param);
  193.     wCalcRgns : DoCalcRgnsMessage(theWindow);
  194.     wNew : ;
  195.     wDispose : ;
  196.     wGrow : ;
  197.   end;
  198. end;
  199.  
  200. {###############################################################################}
  201. {#                                           #}
  202. {#        function GetItemRect(item : integer) : rect;               #}
  203. {#                                           #}
  204. {###############################################################################}
  205.  
  206. function GetItemRect(item : integer) : rect;
  207.   var
  208.     tempRect : Rect;
  209.   begin
  210.     with tempRect do
  211.       begin
  212.         top := (((item - 1) div 8) * 16) - 1;
  213.         bottom := top + 17;
  214.         left := (((item - 1) mod 8) * 16) - 1;
  215.         right := left + 17;
  216.       end;
  217.     GetItemRect := tempRect;
  218.   end;
  219.  
  220. {###############################################################################}
  221. {#                                           #}
  222. {#            procedure DrawPatWindow;                          #}
  223. {#                                           #}
  224. {###############################################################################}
  225.  
  226. procedure DrawPatWindow;
  227.   var
  228.     i : integer;
  229.     currentPat : Pattern;
  230.     currRect : Rect;
  231.   begin
  232.     for i := 1 to 96 do
  233.       begin
  234.         currRect := GetItemRect(i);
  235.         FrameRect(currRect);
  236.     GetIndPattern(currentPat,100,i);
  237.     FillRect(currRect,currentPat);
  238.     FrameRect(currRect);
  239.       end;
  240.   end;
  241.  
  242. {###############################################################################}
  243. {#                                           #}
  244. {#    function GetMItemRect(whichRect : Integer; myRect : Rect) : Rect;      #}
  245. {#                                           #}
  246. {###############################################################################}
  247.  
  248. function GetMItemRect(whichRect : Integer; myRect : Rect) : Rect;
  249.   var
  250.     ItemRect : Rect;
  251.   begin
  252.     ItemRect := GetItemRect(whichRect);
  253.     OffSetRect(itemRect, myRect.left, myRect.top);
  254.     GetMItemRect := ItemRect; 
  255.   end;
  256.  
  257. {###############################################################################}
  258. {#                                           #}
  259. {#         procedure drawItem(myRect : rect; myItem : integer);           #}
  260. {#                                           #}
  261. {###############################################################################}
  262.  
  263.  procedure drawItem(myRect : rect; myItem : integer);
  264.    var
  265.      currentPat : pattern;
  266.    begin
  267.      if (myItem > 0) and (myItem < 97) then
  268.        begin
  269.          myRect := GetMItemRect(myItem,myRect);
  270.          GetIndPattern(currentPat,100,myItem);
  271.          FillRect(myRect,currentPat);
  272.          FrameRect(myRect);
  273.        end;
  274.    end;
  275.  
  276. {###############################################################################}
  277. {#                                           #}
  278. {#        procedure clearitem(myRect : Rect; lastCell : integer);           #}
  279. {#                                           #}
  280. {###############################################################################}
  281.  
  282. procedure clearitem(myRect : Rect; lastCell : integer);
  283.   begin
  284.     DrawItem(myRect,lastCell - 9);
  285.     DrawItem(myRect,lastCell - 8);
  286.     DrawItem(myRect,lastCell - 7);
  287.     DrawItem(myRect,lastCell - 1);
  288.     DrawItem(myRect,lastCell);
  289.     DrawItem(myRect,lastCell + 1);
  290.     DrawItem(myRect,lastCell + 7);
  291.     DrawItem(myRect,lastCell + 8);
  292.     DrawItem(myRect,lastCell + 9);
  293.   end;
  294.  
  295. {###############################################################################}
  296. {#                                           #}
  297. {#            Menu Definition Routine                       #}
  298. {#                                           #}
  299. {###############################################################################}
  300.  
  301. procedure MyMenuDef(message : Integer;
  302.         theMenu : MenuHandle;
  303.         var menuRect : Rect;
  304.         hitPt : Point;
  305.         var whichItem : Integer);
  306.  
  307.   procedure DoDrawMessage(myMenu : MenuHandle;
  308.               myRect : Rect);
  309.     const
  310.       MBarHeight = 20;
  311.     var
  312.       whichRect : Integer;
  313.       currentPat : Pattern;
  314.       currRect : Rect;
  315.     begin
  316.       for whichRect := 1 to 96 do
  317.     Drawitem(myRect,whichRect);
  318.     end;
  319.  
  320.   function DoChooseMessage(myMenu : MenuHandle;
  321.               myRect : Rect;
  322.             myPoint : Point;
  323.             oldItem : Integer) : Integer;
  324.     var
  325.       currRect : Rect;
  326.       alldone : boolean;
  327.       whichRect : Integer;
  328.       oldRect : Rect;
  329.       mPt : Point;
  330.       lastPt : Point;
  331.       lastRect : Rect;
  332.       menuPt : Point;
  333.       tempRect : Rect;
  334.       exitrect : rect;
  335.       saveClip : RgnHandle;
  336.       io : integer;
  337.     begin
  338.       ClipRect(myRect);
  339.       whichRect := 1;
  340.       alldone := false;
  341.       repeat
  342.         currRect := GetMItemRect(whichRect,myRect);
  343.     if PtInRect(myPoint,currRect) then
  344.       alldone := true
  345.     else
  346.       inc(whichRect);
  347.       until ((AllDone) or (whichRect > 96));
  348.       if AllDone then { if we are in a item}
  349.         begin
  350.       if (whichRect <> oldItem) then 
  351.         begin
  352.           if (oldItem <> 0) then 
  353.         ClearItem(myRect,oldItem);
  354.           InsetRect(currRect,-6,-6);
  355.           PenSize(6,6);
  356.           PenPat(white);
  357.           FrameRect(currRect);
  358.           PenNormal;
  359.           InsetRect(currRect,-1,-1);
  360.           FrameRect(currRect);
  361.        end;
  362.        DoChooseMessage := whichRect;
  363.     end
  364.       else { we are not in a item}
  365.         begin
  366.       if oldItem <> 0 then { invert the old item}
  367.         clearitem(myRect,oldItem);
  368.       DoChooseMessage := 0;
  369.  
  370.       PenMode(notPatXOR);
  371.       penpat(gray);
  372.       exitrect := myrect;
  373.       InsetRect(ExitRect,-10,-10);
  374.       ExitRect.top := 20;
  375.       menuPt.h := myRect.left + ((myRect.right - myRect.left) div 2);
  376.           menuPt.v := myRect.top + ((myRect.bottom - myRect.top) div 2);
  377.       SetRect(tempRect,0,0,0,0);
  378.       lastRect := tempRect;
  379.       ClipRect(screenbits.bounds);
  380.       repeat
  381.         GetMouse(mPt);
  382.         LocalToGlobal(mPt);
  383.         if ((Longint(mpt) <> Longint(lastPt)) and
  384.            (not PtInRect(mpt,ExitRect)) and (mPt.v > 20)) then
  385.           begin
  386.             lastPt := mPt;
  387.             tempRect := myRect;
  388.             OffSetRect(tempRect, mPt.h - menuPt.h, mPt.v - menuPt.v);
  389.             if tempRect.top < 20 then
  390.               begin
  391.                 tempRect.top := 20;
  392.             tempRect.bottom := 20 + 202;
  393.               end;
  394.         FrameRect(lastRect);
  395.         FrameRect(tempRect);
  396.         lastRect := tempRect;
  397.           end;
  398.       until (not button) or ptInRect(mPt, exitrect) or (mPt.v < 21);
  399.       FrameRect(lastRect);
  400.       PenNormal;
  401.       if (not PtInRect(mpt,ExitRect)) and (mPt.v > 20) then
  402.         begin
  403.           lastrect.top := lastrect.top + 12;
  404.           io := PostEvent(12,Longint(lastRect.topleft));
  405.           { this communicates back to the main event}
  406.           { loop that a window was just torn from the}
  407.           { menu.  We pass the new topLeft in the message}
  408.         end;
  409.     end;
  410.     end;
  411.  
  412.   procedure DoSizeMessage(var myMenu : MenuHandle);
  413.     begin
  414.       with myMenu^^ do
  415.         begin
  416.           menuWidth := 127;
  417.           menuHeight := 191;
  418.         end;
  419.     end;
  420.  
  421. begin
  422.   case message of
  423.     mSizeMsg : DoSizeMessage(theMenu);
  424.     mDrawMsg : DoDrawMessage(theMenu,menuRect);
  425.     mChooseMsg : whichItem := DoChooseMessage(theMenu,menuRect,hitPt,whichItem);
  426.   end;
  427. end;
  428.  
  429. {###############################################################################}
  430. {#                                           #}
  431. {#                 ShowAbout procedure                   #}
  432. {#                                           #}
  433. {###############################################################################}
  434.  
  435. procedure ShowAbout;
  436. var
  437.   theDlog : DialogPtr;
  438.   theItem : Integer;
  439. begin
  440.   theDlog := GetNewDialog(AboutID,nil,Pointer(-1));
  441.   ModalDialog(nil,theItem);
  442.   DisposDialog(theDlog);
  443. end;
  444.  
  445. {###############################################################################}
  446. {#                                           #}
  447. {#                ProcessMenu procedure                   #}
  448. {#                                           #}
  449. {###############################################################################}
  450.  
  451. procedure ProcessMenu(codeWord : Longint);
  452. type
  453.   PatPtr = ^Pattern;
  454. var
  455.   menuNum : Integer;
  456.   itemNum : Integer;
  457.   NameHolder : str255;
  458.   dummy : Integer;
  459.   yuck : boolean;
  460.   myPattern : Pattern;
  461.   DeskPatternPtr : PatPtr;
  462.   savePort,aPort : grafPtr;
  463.   theRgn1,theRgn2 : RgnHandle;
  464. begin
  465.   if codeWord <> 0 then
  466.     begin
  467.       menuNum := HiWord(codeWord);
  468.       itemNum := LoWord(codeWord);
  469.       case menuNum of { the different menus}
  470.         AppleMenuID :
  471.       if itemNum < 3 then
  472.         ShowAbout
  473.       else
  474.         begin
  475.           GetItem(myMenus[AppleMenuID],itemNum,NameHolder);
  476.           dummy := OpenDeskAcc(NameHolder);
  477.         end;
  478.     FileMenuID : Done := true;
  479.     EditMenuID :yuck := SystemEdit(itemNum - 1);
  480.     GraphicalMenu : 
  481.       if ItemNum <> 0 then
  482.         begin
  483.           GetIndPattern(myPattern,100,ItemNum);
  484.           SetPort(currentPatWind);
  485.           BackPat(myPattern);
  486.           EraseRect(currentPatWind^.portRect);
  487.         end;
  488.       end;
  489.       HiliteMenu(0);
  490.     end;
  491. end;
  492.  
  493. {###############################################################################}
  494. {#                                           #}
  495. {#            Deal With Mouse Downs procedure                   #}
  496. {#                                           #}
  497. {###############################################################################}
  498.  
  499. procedure DealWithMouseDowns(theEvent: EventRecord);
  500. var
  501.   location : Integer;
  502.   windowPointedTo : WindowPtr;
  503.   mouseLoc : point;
  504.   windowLoc : integer;
  505.   VandH : Longint;
  506.   Height : Integer;
  507.   Width : Integer;
  508.   currRect,myRect : Rect;
  509.   newcell,LastCell : integer;
  510.   thePt, LastPt : Point;
  511.   i : integer;
  512.   myPattern : Pattern;
  513. begin
  514.   mouseLoc := theEvent.where;
  515.   windowLoc := FindWindow(mouseLoc,windowPointedTo);
  516.   case windowLoc of
  517.     inMenuBar : 
  518.       ProcessMenu(MenuSelect(mouseLoc));
  519.     inSysWindow : 
  520.       SystemClick(theEvent,windowPointedTo);
  521.     inContent :
  522.       if windowPointedTo <> FrontWindow then
  523.     SelectWindow(windowPointedTo)
  524.       else
  525.     begin
  526.       if RegWDEFWindow = windowPointedTo then
  527.         begin
  528.           SetPort(RegWDEFWindow);
  529.           GetMouse(lastPt);
  530.           newCell := 0;
  531.           lastCell := 0;
  532.               myRect := RegWDEFWindow^.portRect;
  533.           while waitmouseup do {track mouse in pattern wind}
  534.             begin
  535.               GetMouse(thePt);
  536.               if not PtInRect(thePt,myRect) then
  537.                 begin {we moved outside the window}
  538.                   if lastCell <> 0 then
  539.                     clearItem(myRect,lastCell);
  540.                   lastCell := 0;
  541.                 end
  542.               else
  543.                 begin
  544.                   for i := 1 to 96 do
  545.                     if PtInRect(thePt,GetItemRect(i)) then
  546.                       newCell := i;
  547.                   if newCell <> lastCell then
  548.                     begin
  549.                       if (lastCell <> 0) then
  550.                     Clearitem(myRect,lastCell);
  551.                       currRect := GetItemRect(newCell);
  552.                       InsetRect(currRect,-6,-6);
  553.                       PenSize(6,6);
  554.                       PenPat(white);
  555.                       FrameRect(currRect);
  556.                       PenNormal;
  557.                       InsetRect(currRect,-1,-1);
  558.                       FrameRect(currRect);
  559.                       lastCell := newCell;
  560.                     end;
  561.                 end;
  562.             end;
  563.           Clearitem(myRect,lastCell);
  564.           GetIndPattern(myPattern,100,newCell);
  565.           SetPort(currentPatWind);
  566.           BackPat(myPattern);
  567.           EraseRect(currentPatWind^.portRect);
  568.         end;
  569.     end;
  570.     inDrag : 
  571.       begin
  572.         DragWindow(windowPointedTo,mouseLoc,DragArea);
  573.     SelectWindow(windowPointedTo);
  574.       end;
  575.     inGoAway :
  576.       if TrackGoAway(windowPointedTo,mouseLoc) then
  577.     HideWindow(windowPointedTo);
  578.   end;
  579. end;
  580.  
  581. {###############################################################################}
  582. {#                                           #}
  583. {#            Deal With Key Downs procedure                   #}
  584. {#                                           #}
  585. {###############################################################################}
  586.  
  587. procedure DealWithKeyDowns(theEvent: EventRecord);
  588. type
  589.   Trick = packed record
  590.     case boolean of
  591.       true : (long : Longint);
  592.       false : (chr3,chr2,chr1,chr0 : char)
  593.     end;
  594. var
  595.   CharCode : char;
  596.   TrickVar : Trick;
  597. begin
  598.   TrickVar.long := theEvent.message;
  599.   CharCode := TrickVar.chr0;
  600.   if BitAnd(theEvent.modifiers,CmdKey) = CmdKey then {check for a menu selection}
  601.     ProcessMenu(MenuKey(CharCode))
  602. end;
  603.  
  604. {###############################################################################}
  605. {#                                           #}
  606. {#            Deal With Updates procedure                   #}
  607. {#                                           #}
  608. {###############################################################################}
  609.  
  610. procedure DealWithUpdates(theEvent: EventRecord);
  611. var
  612.   UpDateWindow : WindowPtr;
  613.   tempPort : WindowPtr;
  614.  
  615. begin
  616.   UpDateWindow := WindowPtr(theEvent.message);
  617.   GetPort(tempPort);
  618.     SetPort(UpDateWindow);
  619.     BeginUpDate(UpDateWindow);
  620.       EraseRect(UpDateWindow^.portRect);
  621.       if UpdateWindow <> currentPatWind then
  622.         DrawPatWindow;
  623.     EndUpDate(UpDateWindow);
  624.   SetPort(tempPort);
  625. end;
  626.  
  627. {###############################################################################}
  628. {#                                           #}
  629. {#            MainEventLoop procedure                       #}
  630. {#                                           #}
  631. {###############################################################################}
  632.  
  633. procedure MainEventLoop;
  634. var
  635.   Event : EventRecord;
  636.   ProcessIt : boolean;
  637. begin
  638.   repeat
  639.     SystemTask;
  640.     if GetNextEvent(everyEvent, Event) then
  641.       case Event.what of
  642.     mouseDown : DealWithMouseDowns(Event);
  643.     AutoKey : DealWithKeyDowns(Event);
  644.     KeyDown : DealWithKeyDowns(Event);
  645.     UpdateEvt : DealWithUpdates(Event);
  646.     12 :begin { we return this when a window has been torn}
  647.           HideWindow(RegWDefWindow);
  648.           MoveWindow(RegWDefWindow,Point(Event.message).h,
  649.               Point(Event.message).v,true);
  650.           ShowWindow(RegWDEFWindow);
  651.         end;
  652.       end;
  653.   until Done;
  654. end;
  655.  
  656. {###############################################################################}
  657. {#                                           #}
  658. {#                 SetupMemory procedure                   #}
  659. {#                                           #}
  660. {###############################################################################}
  661.  
  662. procedure SetupMemory;
  663. var
  664.   x : Longint;
  665. begin
  666.   x := ORD4(ApplicZone) + 128000;
  667.   SetApplLimit(Pointer(x));
  668.   MaxApplZone;
  669.   MoreMasters;
  670.   MoreMasters;
  671.   MoreMasters;
  672. end;
  673.  
  674. {###############################################################################}
  675. {#                                           #}
  676. {#                 SetupLimits                       #}
  677. {#                                           #}
  678. {###############################################################################}
  679.  
  680. procedure SetupLimits;
  681. var
  682.   Screen : Rect;
  683. begin
  684.   Screen := ScreenBits.bounds;
  685.   with Screen do
  686.     begin
  687.       SetRect(DragArea,left+4,top+24,right-4,bottom-4);
  688.       SetRect(GrowArea,left,top+24,right,bottom);
  689.     end;
  690. end;
  691.  
  692. {###############################################################################}
  693. {#                                           #}
  694. {#                MakeMenus procedure                   #}
  695. {#                                           #}
  696. {###############################################################################}
  697.  
  698. procedure MakeMenus;
  699. var
  700.   index : Integer;
  701. begin
  702.   for index := AppleMenuID to EditMenuID do
  703.     begin
  704.       myMenus[index] := GetMenu(index);
  705.       InsertMenu(myMenus[index],0);
  706.     end;
  707.   AddResMenu(myMenus[AppleMenuID],'DRVR');
  708.  
  709.   MyGraphicsMenu := NewMenu(4,'Graphics');
  710.  
  711.   MyGraphicsMenu^^.menuProc := NewHandle(0); 
  712.   MyGraphicsMenu^^.menuProc^ := Ptr(@MyMenuDef);
  713.   CalcMenuSize(MyGraphicsMenu);
  714.  
  715.   Insertmenu(MyGraphicsMenu,0);
  716.  
  717.   DrawMenuBar;
  718. end;
  719.  
  720. {###############################################################################}
  721. {#                                           #}
  722. {#            Program Excecution Starts Here                   #}
  723. {#                                           #}
  724. {###############################################################################}
  725.  
  726. begin
  727.   Done := false;
  728.   FlushEvents(everyEvent,0);
  729.  
  730.   InitGraf(@thePort);
  731.   InitFonts;
  732.   InitWindows;
  733.   InitMenus;
  734.   TEInit;
  735.   InitDialogs(nil);
  736.   InitCursor;
  737.  
  738.   SetupLimits;
  739.   SetupMemory;
  740.   MakeMenus;
  741.   
  742.   RegWDEFWindow := GetNewWindow(WindResID,nil,Pointer(-1));
  743.   myWindowPeek := WindowPeek(RegWDEFWindow);
  744.   
  745.   myWindowPeek^.windowDefProc := NewHandle(0);
  746.   myWindowPeek^.windowDefProc^ := Ptr(@MyWindowDef);
  747.  
  748.   SetWRefCon(RegWDEFWIndow,Ord4(MyGraphicsMenu));
  749.  
  750.   currentPatWind := GetNewWindow(2,nil,pointer(-1));
  751.   SetPort(currentPatWind);
  752.   BackPat(gray);
  753.   EraseRect(currentPatWind^.portRect);
  754.     
  755.   MainEventLoop;
  756. end. {thats all folkes!}
  757.